home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-06-20 | 53.9 KB | 1,914 lines | [TEXT/MWPS] |
- {$N-}
-
- { Remote Control code }
- { © Copyright 1991-1995 Jim Luther, All rights reserved. }
-
- { Modification History: }
- { 28 Dec 91 JML V1.0d1 First working version with System 7 File Sharing }
- { 31 Dec 91 JML V1.0d1 Added check for Gestalt trap to InitializeApp. }
- { 31 Dec 91 JML V1.0d1 Changed RemoteSCPBRec structure (added scSetup field) }
- { 31 Dec 91 JML V1.0d1 Hacked up every routine that uses SCPSJustDisabled to }
- { also use SCPSSleeping. }
- { 31 Dec 91 JML V1.0d2 Works with AppleShare 3.0 }
- { 31 Dec 91 JML V1.0d2 Added "Already controlled" alert if StartSecureSession returns }
- { noInformErr }
- { 2 Jan 92 JML V1.0d2 Got my creator assignments, so I added a BNDL, ICN#, etc and }
- { changed a few things to use the new creator types and the }
- { version resources. }
- { 3 Jan 92 JML V1.0d2+ Restored the Initialization OFF directive for THINK Pascal }
- { that somehow was deleted... }
- { 3 Jan 92 JML V1.0d2++ Handle default user changed on remote system at }
- { StartSecureSession. }
- { 10 Mar 93 JML V1.0 Ahhh, just release the dang thing. It works fine. }
- { 21 May 95 JML V1.1b1 Make it compile with Metrowerks Pascal CW6 and }
- { Universal Interfaces (what a hassle!). }
- { 22 May 95 JML V1.1b1 Added Open and Save connection document code. }
- { 22 May 95 JML V1.1b1 Added open document AppleEvent handler code. }
- { 22 May 95 JML V1.1b1 Cached "NoLocation" name - the GetMyZone call for every update }
- { was killing update performance. }
-
- {$IFC UNDEFINED THINK_Pascal}
- {$ELSEC}
- {$I-}
- {$ENDC}
-
- PROGRAM RemoteShare;
-
- USES
- Types, Memory, Packages, Errors, Quickdraw, Controls, Fonts, Dialogs, Windows, Menus, Events, DiskInit, OSUtils, Resources, ToolUtils, AppleTalk, Processes, PPCToolbox, EPPC, Notification, AppleEvents, GestaltEqu, Traps, Balloons, Script, TextEdit, Devices, SegLoad, StandardFile, ServerControlIntf;
-
- CONST
- kPortName = 'Remote Control'; { should use a resource string }
-
- kControllerCreator = 'ASsc'; { used for remote PPC port's portCreator and nbpType }
- kRemoteCreator = 'ASrc'; { used for our PPC port's portCreator }
- kRemoteConnectionType = 'SRCC'; { used for saved connection files }
-
- { Saved connection file resource ID and types }
- kSavedConnectionID = 128;
- kSavedPortInfoRec = 'SPIR';
- kSavedSessLocationName = 'SSLN';
- kSaveConnectionPrompt = 128; { 'STR ' for StandardPutFile prompt }
-
- { window, dialog, and alert resources }
- kAboutBox = 200; { AboutBox alert }
-
- kMyWindowResource = 500; { the window and window title STR resource IDs }
- kRemoteMac = 501; { 'Remote Macintosh' RECT and STR resource IDs }
- kRemoteFileSrvr = 502; { 'Remote File Server' RECT and STR resource IDs }
- kRemoteMacNameLabel = 503; { 'Macintosh Name:' RECT and STR resource IDs }
- kRemoteMacName = 504; { Macintosh name RECT resource ID }
- kRemoteZoneLabel = 505; { 'Zone:' RECT and STR resource IDs }
- kRemoteZoneName = 506; { Zone name RECT resource ID }
- kRemoteStatusLabel = 507; { 'Status:' RECT and STR resource IDs }
-
- kRemoteStatusText = 508; { Status text RECT and STR# resource IDs }
- kStatusOff = 1;
- kStatusStarting = 2;
- kStatusOn = 3;
- kStatusLessThan1Minute = 4;
- kStatusOneMinute = 5;
- kStatusXMinutes = 6;
- kStatusSleeping = 7;
-
- kRemoteDivLine = 509; { Dividing line RECT resource IDs }
-
- kWindowButton = 510; { the button control and STR# resource IDs }
- kButtonStart = 1;
- kButtonCancel = 2;
- kButtonStop = 3;
-
- kNotOwnerAlert = 501; { remote is not owner alert }
-
- kShutdownDialog = 502; { how long before shutdown dialog }
- kShutdownTime = 3; { editText item }
- kShutdownOKOutline = 5; { user item number of OK outline }
-
- kAlreadyControlled = 503; { the server is already controlled alert }
-
- kSampHelp = 600; { Help dialog }
-
-
- { menu constants }
- kMBarID = 128;
-
- kAppleMenu = 128; { the Apple menu }
-
- kFileMenu = 129; { the File menu }
- kOpenItem = 1;
- kSaveItem = 2;
- kQuitItem = 4;
-
- kEditMenu = 130; { the Edit menu }
-
- kRemoteMenu = 131; { the Sharing menu }
- kConnectToRemote = 1; { the connect/disconnect menu item }
- kConnectString = 1; { 'STR#' item numbers }
- kDisconnectString = 2;
-
- kHelpString = 600; { help menu item string }
-
-
- { PPCReject rejectInfo codes }
- kRemoteIsNotOwner = 1;
- kRemoteAppUnknown = -1; { •••Remote Control should never get this }
-
- kPPCIOBufSize = 2048; { kPPCIOBufSize is the size of the I/O buffer used by }
- { the session. 2K is big enough to send or receive }
- { anything a server control call will use. }
-
- kExitErrorStrings = 128;
- kNumExitErrors = 10; { number of exit errors }
- { ExitToShell errors }
- kExitNoSystem7 = 1;
- kExitNoAppleEvts = 2;
- kExitAEHandlerNotInstalled = 3;
- kExitNoOwnerName = 4; { •••not used in Remote Control }
- kExitNoPPC = 5;
- kExitPPCInitFailed = 6;
- kExitAppleTalkDisabled = 7;
- kExitProgramLinkingDisabled = 8; { •••not used in Remote Control }
- kExitPPCOpenFailed = 9;
- kExitPPCInformFailed = 10; { •••not used in Remote Control }
-
- {ServerControl constants}
- kSIMaxLogins = 200;
-
- kVerNumType = $01008000; { NumVersion.version used for the remote and our }
- { PPC ports' portType. In this case version 1.0.0 final. }
-
- TYPE
- { Handle types for saving connection }
- PortInfoHandle = ^PortInfoPtr;
- LocationNameHandle = ^LocationNamePtr;
-
- RemoteSCPBRecPtr = ^RemoteSCPBRec;
- RemoteSCPBRec = RECORD
- scPB: SCParamBlockRec;
- scMessageOrName: Str255;
- scDiscArray: ARRAY[1..kSIMaxLogins] OF LongInt;
- scSetup: SetupInfoRec;
- END;
- PPCIOBuffer = RemoteSCPBRec;
-
- RectHndl = ^RectPtr;
-
- VAR
- gQuit, gInBackground: Boolean;
-
- gMymenu: Handle; { my menu bar handle }
- gAppleMenuHandle, gFileMenuHandle, gEditMenuHandle, gRemoteMenuHandle: MenuHandle;
-
- myWindow: WindowPtr;
- gWindowButton: ControlRef;
- gWindBttnHilite: Integer;
- gHelpItem: Integer; { 0 if no help item }
-
- gOurPSN: ProcessSerialNumber;
- gShortVersStr: Str255; { NumVersion.shortVersion used for about box }
-
- gPPCPortOpen: Boolean; { TRUE when the PPC port has been opened }
- gPPCPortRefNum: PPCPortRefNum; { The PPC port reference number }
- gPPCSessRefNum: PPCSessRefNum; { The PPC session reference number }
-
- gPPCGeneralRec: PPCParamBlockRec;
- gPPCSessPortName: PPCPortRec;
- gPPCSessLocationName: LocationNameRec;
- gPPCSessUserName: Str32;
- gPPCReadBuffer: PPCIOBuffer;
- gPPCDataRead: Boolean;
- gPortInfoRec: PortInfoRec;
-
- gRemoteSCpb: RemoteSCPBRec;
- gFirstStatus: Boolean;
- oldSCServerState: Integer;
-
- gPPCWriteRec: PPCParamBlockRec; { used for PPCWrite calls }
- gPPCWriteInProgress: Boolean;
-
-
- gPPCEndRec: PPCParamBlockRec; { used for PPCEnd calls }
-
- gNotificationMgrPresent: Boolean;
- gNMRec: NMRec;
- gNMStrs: ARRAY[1..kNumExitErrors] OF Str255;
-
- gNoLocationZoneName: Str32;
-
- {==============================================================================}
-
- {$S Main}
- PROCEDURE NotifyResponseProc (nmReqPtr: NMRecPtr);
- VAR
- oldA5: LongInt;
- err: OSErr;
- BEGIN
- oldA5 := SetA5(nmReqPtr^.nmRefCon);
- gQuit := TRUE;
- err := WakeUpProcess(gOurPSN);
- err := NMRemove(nmReqPtr);
- oldA5 := SetA5(oldA5);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE NotifyAndExit (errCode: Integer);
- BEGIN
- IF gNotificationMgrPresent THEN
- BEGIN
- WITH gNMRec DO
- BEGIN
- qType := ORD(nmType);
- nmMark := 0;
- nmIcon := NIL;
- nmSound := Handle(-1);
- nmStr := @gNMStrs[errCode];
- nmResp := @NotifyResponseProc;
- nmRefCon := SetCurrentA5;
- END;
-
- IF (NMInstall(@gNMRec) <> noErr) THEN
- BEGIN
- gQuit := TRUE;
- END;
- END
- ELSE
- BEGIN
- gQuit := TRUE;
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- { DoDiskEvents just checks the error code from the disk mount, }
- { and puts up the 'Format' dialog (through DIBadMount) if need be }
- { You can do much more here if you care about what disks are }
- { in the drive }
- PROCEDURE DoDiskEvents (dinfo: LongInt);
- { hi word is error code, lo word is drive number }
- VAR
- hival, loval, tommy: Integer;
- fredpoint: Point;
- BEGIN
- fredpoint.v := 40;
- fredpoint.h := 40;
- hival := HiWord(dinfo);
- loval := LoWord(dinfo);
- IF hival <> noErr THEN { something happened }
- BEGIN
- tommy := DIBadMount(fredpoint, dinfo);
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- { This is my sample help dialog. It doesn't do anything. Expand as you need. }
- PROCEDURE SampleHelpDialog;
- VAR
- tdial: DialogPtr;
- itemHit: Integer;
- BEGIN
- tdial := GetNewDialog(kSampHelp, NIL, WindowPtr(-1));
- REPEAT
- ModalDialog(NIL, itemhit);
- UNTIL (itemhit = 1);
- DisposeDialog(tdial);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE HiliteMyButton;
- CONST
- active = 0;
- inactive = 255;
- BEGIN
- IF (gWindowButton <> NIL) THEN
- BEGIN
- IF ((NOT gPPCWriteInProgress) AND (NOT gInBackground) AND (NOT gFirstStatus)) THEN
- BEGIN
- IF (gWindBttnHilite <> active) THEN
- BEGIN
- HiliteControl(gWindowButton, active);
- gWindBttnHilite := active;
- END;
- END
- ELSE
- BEGIN
- IF (gWindBttnHilite <> inactive) THEN
- BEGIN
- HiliteControl(gWindowButton, inactive);
- gWindBttnHilite := inactive;
- END;
- END;
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- { draws my window. }
- PROCEDURE DrawMain (drawit: WindowPtr);
- VAR
- r: Rect;
- h: Handle;
- strH: StringHandle;
- str, numStr: Str255;
- i: Integer;
- theXPPPB: XPPParamBlock;
- BEGIN
- BeginUpdate(drawIt);
- SetPort(drawIt);
-
- DrawControls(drawIt);
-
- TextFont(systemFont);
- TextSize(12);
- TextFace([]);
-
- h := GetResource('RECT', kRemoteMac);
- r := RectHndl(h)^^;
- MoveTo(r.left, r.bottom);
- strH := GetString(kRemoteMac);
- str := strH^^;
- DrawString(str);
-
- h := GetResource('RECT', kRemoteFileSrvr);
- r := RectHndl(h)^^;
- MoveTo(r.left, r.bottom);
- strH := GetString(kRemoteFileSrvr);
- str := strH^^;
- DrawString(str);
-
- TextFont(geneva);
- TextSize(9);
-
- TextFace([bold]);
-
- h := GetResource('RECT', kRemoteMacNameLabel);
- r := RectHndl(h)^^;
- MoveTo(r.left, r.bottom);
- strH := GetString(kRemoteMacNameLabel);
- str := strH^^;
- DrawString(str);
-
- h := GetResource('RECT', kRemoteZoneLabel);
- r := RectHndl(h)^^;
- MoveTo(r.left, r.bottom);
- strH := GetString(kRemoteZoneLabel);
- str := strH^^;
- DrawString(str);
-
- h := GetResource('RECT', kRemoteStatusLabel);
- r := RectHndl(h)^^;
- MoveTo(r.left, r.bottom);
- strH := GetString(kRemoteStatusLabel);
- str := strH^^;
- DrawString(str);
-
- TextFace([]);
-
- h := GetResource('RECT', kRemoteMacName);
- r := RectHndl(h)^^;
- MoveTo(r.left, r.bottom);
- IF (gPPCSessLocationName.locationKindSelector = ppcNoLocation) THEN
- BEGIN
- strH := GetString(-16413);
- str := strH^^;
- DrawString(str);
- END
- ELSE
- BEGIN
- DrawString(gPPCSessLocationName.nbpEntity.objStr);
- END;
-
- h := GetResource('RECT', kRemoteZoneName);
- r := RectHndl(h)^^;
- MoveTo(r.left, r.bottom);
- IF (gPPCSessLocationName.locationKindSelector = ppcNoLocation) THEN
- BEGIN
- IF (gNoLocationZoneName = '') THEN
- BEGIN
- WITH theXPPPB DO
- BEGIN
- xppTimeOut := 1;
- xppRetry := 3;
- zipBuffPtr := @gNoLocationZoneName;
- zipInfoField[1] := 0;
- zipInfoField[2] := 0;
- END;
- IF GetMyZone(@theXPPPB, FALSE) <> noErr THEN
- BEGIN
- gNoLocationZoneName := '*';
- END;
- END;
- DrawString(gNoLocationZoneName);
- END
- ELSE
- BEGIN
- DrawString(gPPCSessLocationName.nbpEntity.zoneStr);
- END;
-
- IF (NOT gFirstStatus) THEN
- BEGIN
- h := GetResource('RECT', kRemoteStatusText);
- r := RectHndl(h)^^;
- CASE oldSCServerState OF
- SCPSSleeping:
- BEGIN
- GetIndString(str, kRemoteStatusText, kStatusSleeping);
- END;
- SCPSJustDisabled:
- BEGIN
- GetIndString(str, kRemoteStatusText, kStatusOff);
- END;
- SCPSStartingUp:
- BEGIN
- GetIndString(str, kRemoteStatusText, kStatusStarting);
- END;
- SCPSRunning:
- BEGIN
- GetIndString(str, kRemoteStatusText, kStatusOn);
- END;
- 0:
- BEGIN
- GetIndString(str, kRemoteStatusText, kStatusLessThan1Minute);
- END;
- 1:
- BEGIN
- GetIndString(str, kRemoteStatusText, kStatusOneMinute);
- END;
- OTHERWISE
- BEGIN
- GetIndString(str, kRemoteStatusText, kStatusXMinutes);
- i := Pos('^', str); { find marker }
- Delete(str, i, 1); { delete marker }
- NumToString(oldSCServerState, numStr);
- Insert(numStr, str, i); { insert numStr }
- END;
- END;
- TETextBox(@str[1], Length(str), r, teJustLeft);
- END;
-
- PenNormal;
-
- h := GetResource('RECT', kRemoteDivLine);
- r := RectHndl(h)^^;
- MoveTo(r.left, r.bottom);
- LineTo(r.right, r.bottom);
-
- EndUpdate(drawIt);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE EndCompProc (pb: PPCParamBlockPtr);
- { This procedure gets called when the asynchronous PPCEnd call completes. }
-
- BEGIN
- gFirstStatus := TRUE; { reset gFirstStatus so first status returned by a }
- { new connection updates the status message }
- gPPCSessRefNum := 0; { the session is closing }
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE ReadCompProc (pb: PPCParamBlockPtr);
- { This procedure gets called when the asynchronous PPCRead call completes.}
- { If no errors are detected, then it puts the parameter block in the }
- { gRpbQueue where the PPCProcessReads procedure will find it and process }
- { the data read. PPCProcessReads will make another PPCRead call. }
- { If an error is detected, then PPCEnd is called asynchronously to close}
- { the session. }
-
- VAR
- err: OSErr; { used to catch the PPC function results. }
-
- BEGIN
- IF (PPCReadPBPtr(pb)^.ioResult = noErr) THEN
- BEGIN
- gPPCDataRead := TRUE;
- err := WakeUpProcess(gOurPSN);
- END
- ELSE
- BEGIN
- { if we get an error, then we call PPCEnd to close up cleanly}
- WITH pb^.endParam DO
- BEGIN
- ioCompletion := @EndCompProc;
- sessRefNum := gPPCSessRefNum;
- END;
- err := PPCEnd(@pb^.endParam, TRUE);
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION myBrowserPortFilter (theLocationNameRec: LocationNameRec;
- thePortInfoRec: PortInfoRec): Boolean;
-
- BEGIN
- { filter on creator type and majorRev field of version number }
- IF (thePortInfoRec.name.portKindSelector = ppcByCreatorAndType) THEN
- BEGIN
- IF ((thePortInfoRec.name.portCreator = kControllerCreator) AND (LongInt(thePortInfoRec.name.portType) = kVerNumType)) THEN
- BEGIN
- myBrowserPortFilter := TRUE;
- END
- ELSE
- BEGIN
- myBrowserPortFilter := FALSE;
- END;
- END
- ELSE
- BEGIN
- myBrowserPortFilter := FALSE;
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION myPPCBrowser (VAR theLocationNameRec: LocationNameRec;
- VAR thePortInfoRec: PortInfoRec): OSErr;
-
- VAR
- theLocNBPType: Str32;
-
- BEGIN
- theLocNBPType := kControllerCreator; { Match this NBP type }
-
- myPPCBrowser := PPCBrowser('', '', FALSE, theLocationNameRec, thePortInfoRec, @myBrowserPortFilter, theLocNBPType);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION DeleteNewUserRefNum (newUserRef: LongInt): OSErr;
-
- VAR
- err: OSErr;
- defUserRef: LongInt;
- defUserName: Str32;
-
- BEGIN
- IF (newUserRef <> 0) THEN
- BEGIN
- err := GetDefaultUser(defUserRef, defUserName);
- IF (err = noErr) THEN { there is a default user }
- BEGIN
- IF newUserRef <> defUserRef THEN { it's not the default, so delete it }
- err := DeleteUserIdentity(newUserRef);
- END
- ELSE { there is no default, so delete it }
- BEGIN
- err := DeleteUserIdentity(newUserRef);
- END;
- DeleteNewUserRefNum := err;
- END
- ELSE { user reference number passed was the guest }
- BEGIN
- deleteNewUserRefNum := noErr;
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION myStartSecureSession (VAR theSessRefNum: PPCSessRefNum;
- VAR theRejectInfo: LongInt): OSErr;
-
- VAR
- thePPCStartPBRec: PPCStartPBRec;
- useDefault: Boolean;
- guestSelected: Boolean;
- userName: Str32;
- err: OSErr;
-
- BEGIN
- WITH thePPCStartPBRec DO
- BEGIN
- ioCompletion := NIL;
- portRefNum := gPPCPortRefNum; { from PPCOpen }
- serviceType := CHAR(ppcServiceRealTime);
- resFlag := 0;
- portName := @gPortInfoRec.name; { from PPCBrowser }
- locationName := @gPPCSessLocationName; { from PPCBrowser }
- userData := 0; { not used }
- END;
-
- { Try to connect with default user identity }
- useDefault := TRUE;
- userName := '';
-
- err := StartSecureSession(@thePPCStartPBRec, userName, useDefault, FALSE, guestSelected, stringPtr(NIL)^);
- IF (err = noUserNameErr) THEN
- BEGIN
- useDefault := FALSE;
- err := StartSecureSession(@thePPCStartPBRec, userName, useDefault, FALSE, guestSelected, stringPtr(NIL)^);
- END;
-
- IF (err = noErr) THEN
- BEGIN
- theSessRefNum := thePPCStartPBRec.sessRefNum;
- err := DeleteNewUserRefNum(thePPCStartPBRec.userRefNum);
- err := noErr; { I don't want to return error from DeleteNewUserRefNum }
- END
- ELSE IF err = userRejectErr THEN { return the rejectInfo from PPCReject }
- theRejectInfo := thePPCStartPBRec.rejectInfo;
-
- myStartSecureSession := err;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE StartConnection;
- VAR
- err: OSErr;
- rejectInfo: LongInt;
- qq: Integer;
- WindowName: Handle;
- BEGIN
- err := myStartSecureSession(gPPCSessRefNum, rejectInfo);
- IF (err <> noErr) THEN
- BEGIN
- CASE err OF
- userRejectErr:
- BEGIN
- CASE rejectInfo OF {probably won't need this CASE, but if I think of any other reject errors...}
- kRemoteIsNotOwner:
- qq := Alert(kNotOwnerAlert, NIL); { put up alert }
- END;
- gPPCSessRefNum := 0;
- Exit(StartConnection);
- END;
- noInformErr:
- BEGIN
- qq := Alert(kAlreadyControlled, NIL); { put up alert }
- Exit(StartConnection);
- END;
- OTHERWISE
- ;
- END;
- END;
-
- IF (err <> noErr) THEN
- Exit(StartConnection);
-
- { start the first PPCRead }
- WITH gPPCGeneralRec.readParam DO
- BEGIN
- ioCompletion := @ReadCompProc;
- sessRefNum := gPPCSessRefNum;
- bufferLength := sizeof(RemoteSCPBRec);
- bufferPtr := @gPPCReadBuffer;
- END;
- gPPCDataRead := FALSE;
- err := PPCRead(@gPPCGeneralRec.readParam, TRUE); { asynchronously }
-
- myWindow := GetNewWindow(kMyWindowResource, Ptr(NIL), WindowPtr(-1));
- WindowName := GetResource('STR ', kMyWindowResource);
- HLock(WindowName);
- SetWTitle(myWindow, StringHandle(WindowName)^^);
- HUnlock(WindowName);
- gWindowButton := GetNewControl(kWindowButton, myWindow);
- ShowWindow(myWindow);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE DoConnectToRemote;
- VAR
- err: OSErr;
- thePPCEndPBRec: PPCEndPBRec;
- BEGIN
- IF (gPPCSessRefNum = 0) THEN
- BEGIN { Attempt to connect to remote }
- IF (myPPCBrowser(gPPCSessLocationName, gPortInfoRec) <> noErr) THEN
- Exit(DoConnectToRemote);
- StartConnection;
- END
- ELSE
- BEGIN { Disconect from Remote }
- WITH gPPCEndRec.endParam DO
- BEGIN
- ioCompletion := @EndCompProc;
- sessRefNum := gPPCSessRefNum;
- END;
- err := PPCEnd(@gPPCEndRec.endParam, TRUE);
- DisposeWindow(myWindow);
- myWindow := NIL;
- gWindowButton := NIL;
- gNoLocationZoneName := '';
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE StartConnectionFromFile (spec: FSSpec);
- VAR
- resRefNum: INTEGER;
- portInfoRes: PortInfoHandle;
- locationNameRes: LocationNameHandle;
- BEGIN
- resRefNum := FSpOpenResFile(spec, fsRdPerm);
- IF (resRefNum = -1) THEN
- Exit(StartConnectionFromFile);
-
- portInfoRes := PortInfoHandle(Get1Resource(kSavedPortInfoRec, kSavedConnectionID));
- IF (portInfoRes <> NIL) THEN
- BEGIN
- HLock(Handle(portInfoRes));
- DetachResource(Handle(portInfoRes));
- END;
-
- locationNameRes := LocationNameHandle(Get1Resource(kSavedSessLocationName, kSavedConnectionID));
- IF (locationNameRes <> NIL) THEN
- BEGIN
- HLock(Handle(locationNameRes));
- DetachResource(Handle(locationNameRes));
- END;
- CloseResFile(resRefNum);
-
- IF (portInfoRes <> NIL) AND (locationNameRes <> NIL) THEN
- BEGIN
- gPortInfoRec := portInfoRes^^;
- gPPCSessLocationName := locationNameRes^^;
- StartConnection;
- END;
-
- IF (portInfoRes <> NIL) THEN
- BEGIN
- HUnlock(Handle(portInfoRes));
- DisposeHandle(Handle(portInfoRes));
- END;
-
- IF (locationNameRes <> NIL) THEN
- BEGIN
- HUnlock(Handle(locationNameRes));
- DisposeHandle(Handle(locationNameRes));
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION GetFileFilter (pb: CInfoPBPtr): BOOLEAN;
- BEGIN
- IF ((pb^.ioFlFndrInfo.fdType = kRemoteConnectionType) AND (pb^.ioFlFndrInfo.fdCreator = kRemoteCreator)) THEN
- BEGIN
- GetFileFilter := FALSE
- END
- ELSE
- BEGIN
- GetFileFilter := TRUE;
- END;
- END;
-
- {$S Main}
- PROCEDURE GetConnection;
- VAR
- fileFilter: FileFilterUPP;
- reply: StandardFileReply;
- typeList: SFTypeList;
- BEGIN
- { get gPortInfoRec and gPPCSessLocationName }
- fileFilter := NIL;
- typeList[0] := kRemoteConnectionType;
- fileFilter := NewFileFilterProc(@GetFileFilter);
- StandardGetFile(fileFilter, -1, NIL, reply);
- IF (NOT reply.sfGood) THEN
- Exit(GetConnection);
-
- StartConnectionFromFile(reply.sfFile);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE SaveConnection;
- VAR
- strH: StringHandle;
- prompt: Str255;
- defaultName: Str255;
- reply: StandardFileReply;
- result: OSErr;
- resRefNum: INTEGER;
- portInfoRes: PortInfoHandle;
- locationNameRes: LocationNameHandle;
- BEGIN
- { save gPortInfoRec and gPPCSessLocationName }
- strH := GetString(kSaveConnectionPrompt);
- IF (strH = NIL) THEN
- prompt := 'Save current connection as:'
- ELSE
- BEGIN
- prompt := strH^^;
- END;
-
- IF gPPCSessLocationName.locationKindSelector = ppcNoLocation THEN
- BEGIN
- strH := GetString(-16413);
- defaultName := strH^^;
- END
- ELSE
- BEGIN
- defaultName := gPPCSessLocationName.nbpEntity.objStr;
- END;
-
- StandardPutFile(prompt, defaultName, reply);
- IF (NOT reply.sfGood) THEN
- Exit(SaveConnection);
-
- IF (reply.sfReplacing) THEN
- BEGIN
- IF (FSpDelete(reply.sfFile) <> noErr) THEN
- Exit(SaveConnection);
- END;
-
- FSpCreateResFile(reply.sfFile, kRemoteCreator, kRemoteConnectionType, 0);
- result := ResError;
- IF (result = noErr) THEN
- BEGIN
- resRefNum := FSpOpenResFile(reply.sfFile, fsRdWrPerm);
- IF (resRefNum = -1) THEN
- Exit(SaveConnection);
-
- portInfoRes := PortInfoHandle(NewHandle(sizeof(PortInfoRec)));
- locationNameRes := LocationNameHandle(NewHandle(sizeof(LocationNameRec)));
- IF ((portInfoRes <> NIL) AND (locationNameRes <> NIL)) THEN
- BEGIN
- BlockMove(@gPortInfoRec, portInfoRes^, sizeof(PortInfoRec));
- AddResource(Handle(portInfoRes), kSavedPortInfoRec, kSavedConnectionID, '');
- result := ResError;
- IF (result = noErr) THEN
- BEGIN
- BlockMove(@gPPCSessLocationName, locationNameRes^, sizeof(LocationNameRec));
- AddResource(Handle(locationNameRes), kSavedSessLocationName, kSavedConnectionID, '');
- result := ResError;
- END;
- END
- ELSE
- BEGIN
- result := memFullErr;
- END;
-
- CloseResFile(resRefNum);
-
- IF (result <> noErr) THEN
- BEGIN
- result := FSpDelete(reply.sfFile)
- END;
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- { my menu action taker }
- PROCEDURE DoSelected (val: LongInt);
- VAR
- hival, loval: Integer;
- qq: Integer;
- DAname: Str255;
- BEGIN
- loval := LoWord(val);
- hival := HiWord(val);
-
- CASE hival OF { switch off the menu number selected }
- kAppleMenu:
- BEGIN
- IF (loval <> 1) THEN {if this was not About, it's a DA }
- BEGIN
- GetMenuItemText(gAppleMenuHandle, loval, DAname);
- qq := OpenDeskAcc(DAname);
- END
- ELSE
- BEGIN
- ParamText(gShortVersStr, '', '', '');
- qq := Alert(kAboutBox, NIL); { do about box }
- END;
- END;
- kFileMenu:
- BEGIN
- CASE loval OF
- kOpenItem:
- BEGIN
- GetConnection;
- END;
- kSaveItem:
- BEGIN
- SaveConnection;
- END;
- kQuitItem:
- BEGIN
- gQuit := TRUE;
- END;
- OTHERWISE
- ;
- END; { case loval }
- END;
- kEditMenu:
- BEGIN
- { edit menu junk }
- { don't care }
- END;
- kRemoteMenu:
- BEGIN
- IF (loval = kConnectToRemote) THEN
- DoConnectToRemote;
- END;
- kHMHelpMenuID: { Defined in Balloons }
- { I only care about this item. If anything else is returned here, I don't know what }
- { it is, so I leave it alone. Remember, the Help Manager chapter says that }
- { Apple reserves the right to add and change things in the Help menu }
- BEGIN
- IF (loval = gHelpItem) THEN
- SampleHelpDialog;
- END;
- OTHERWISE
- ;
- END; { CASE hival }
- HiliteMenu(0);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION OpenPPCPort: OSErr;
- { OpenPPCPort opens a PPC port for use by the server sessions.}
- { It initializes the port name and location name records.}
- { Then, it calls PPCOpen synchronously to open the port. If the port was}
- { sucessfully opened, the gPPCPortOpen is set TRUE, and gPPCPortRefNum is set to}
- { the port reference number returned by PPCOpen.}
- { Any errors detected are passed back to PPCStartUp to be returned to}
- { the application. }
-
- VAR
- thePortRec: PPCPortRec; { the port name of the port to be opened. }
- theOpenPBRec: PPCOpenPBRec; { used by the PPCOpen call. }
- err: OSErr; { used to keep track of errors within the function. }
- BEGIN
- { initialize the port name record }
- WITH thePortRec DO
- BEGIN
- nameScript := GetScriptManagerVariable(smSysScript); { use Script Manager call to get System Script }
- name := kPortName; { This is the name that will show up in the }
- { "Programs" list that the Browser puts up.}
- { It should be a resource string instead of }
- { hard coded (as done here).}
- portKindSelector := ppcByCreatorAndType; { port kind by creator/type }
- portCreator := kRemoteCreator;
- portType := OSType(kVerNumType);
- END;
-
- { Now, set up Open parameter block record }
- WITH theOpenPBRec DO
- BEGIN
- ioCompletion := NIL; { no completion Proc needed (synchronous) }
- serviceType := CHAR(ppcServiceRealTime); { 7.0 only supports this type of service }
- resFlag := 0; { must be zero }
- portName := @thePortRec; { pointer to port record}
- locationName := NIL;
- networkVisible := FALSE; { No reason to be seen }
- END;
-
- { execute PPCOpen synchronously and return any errors to caller }
- err := PPCOpen(@theOpenPBRec, FALSE);
- IF (err = noErr) THEN
- BEGIN
- gPPCPortOpen := TRUE; { set the global port open flag }
- gPPCPortRefNum := theOpenPBRec.portRefNum; { set the global port reference number }
- END;
- OpenPPCPort := err;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE PPCShutDown;
- { PPCShutDown first closes the PPC port that was opened by PPCStartUp.}
- { Closing the port will automatically kill all sessions that use that port.}
- { After closing the port, PPCShutDown disposes of all session records. }
-
- VAR
- theClosePBRec: PPCClosePBRec;
- err: OSErr;
- BEGIN
- { Close the port. This will cause all PPC calls associated with this port }
- { to complete. }
- IF (gPPCPortOpen) THEN { close the port }
- BEGIN
- gPPCPortOpen := FALSE; { tell completion routines we're shutting down }
- { so they won't try to restart a session }
- theClosePBRec.ioCompletion := NIL;
- theClosePBRec.portRefNum := gPPCPortRefNum;
- err := PPCClose(@theClosePBRec, FALSE);
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Initialize}
- FUNCTION InitPPCStuff: Boolean;
- VAR
- PPCAttributes: LongInt; {Storage for the response from Gestalt}
- err: OSErr; {Temporary variable to catch errors}
- BEGIN
- InitPPCStuff := FALSE;
- IF (Gestalt(gestaltPPCToolboxAttr, PPCAttributes) <> noErr) THEN
- BEGIN
- NotifyAndExit(kExitNoPPC); { Bail out now }
- Exit(InitPPCStuff);
- END;
-
- { ELSE PPC Toolbox is present }
-
- { Does PPC need initialization? }
- IF (BAND(PPCAttributes, gestaltPPCSupportsRealTime) = 0) THEN
- BEGIN { PPC Toolbox needs initialization }
- { initialize the PPC Toolbox and set function result }
- IF PPCInit = noErr THEN
- { get the post-init attributes for the PPC Toolbox }
- err := Gestalt(gestaltPPCToolboxAttr, PPCAttributes)
- ELSE { PPC can't be inited }
- BEGIN
- NotifyAndExit(kExitPPCInitFailed); { Bail out now }
- Exit(InitPPCStuff);
- END;
- END;
-
- { Make sure ports can be opened to the outside world }
- IF (BAND(PPCAttributes, gestaltPPCSupportsOutGoing) = 0) THEN
- { It's likely that AppleTalk is disabled, so you }
- { may want to tell the user to activate AppleTalk }
- { from the Chooser. }
- BEGIN
- NotifyAndExit(kExitAppleTalkDisabled); { Bail out now }
- Exit(InitPPCStuff);
- END;
-
- IF (OpenPPCPort <> noErr) THEN
- { couldn't open a PPC port }
- BEGIN
- NotifyAndExit(kExitPPCOpenFailed); { Bail out now }
- Exit(InitPPCStuff);
- END;
-
- InitPPCStuff := TRUE;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- { This is the standard Open Application event. }
- FUNCTION AEOpenHandler (messagein: AppleEvent;
- reply: AppleEvent;
- refIn: LongInt): OSErr;
- BEGIN
- { of course, we don't do anything here in this simple app }
- AEOpenHandler := noErr;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- { Open Doc, opens our documents. Remember, this can happen at application start AND }
- { anytime else. If your app is up and running and the user goes to the desktop, hilites one }
- { of your files, and double-clicks or selects Open from the Finder File menu this event }
- { handler will get called. Which means you don't do any initialization of globals here, or }
- { anything else except open then doc. }
- { SO-- Do NOT assume that you are at app start time in this }
- { routine, or bad things will surely happen to you. }
- FUNCTION AEOpenDocHandler (messagein: AppleEvent;
- reply: AppleEvent;
- refIn: LongInt): OSErr;
- VAR
- myFSS: FSSpec;
- docList: AEDescList;
- myErr: OSErr;
- itemsInList: LongInt;
- actualSize: Size;
- keywd: AEKeyword;
- returnedType: DescType;
- BEGIN
- IF (gPPCSessRefNum = 0) THEN
- BEGIN
- {get the direct parameter--a descriptor list--and put it into docList}
- myErr := AEGetParamDesc(messagein, keyDirectObject, typeAEList, docList);
- IF myErr <> noErr THEN
- BEGIN
- AEOpenDocHandler := myErr;
- Exit(AEOpenDocHandler);
- END;
-
- {count the number of descriptor records in the list}
- myErr := AECountItems(docList, itemsInList);
- IF myErr <> noErr THEN
- BEGIN
- AEOpenDocHandler := myErr;
- Exit(AEOpenDocHandler);
- END;
-
- IF itemsInList > 0 THEN
- BEGIN
- { now get the first descriptor record from the list, coerce the returned }
- { data to an FSSpec record, and start the connection }
- myErr := AEGetNthPtr(docList, 1, typeFSS, keywd, returnedType, @myFSS, Sizeof(myFSS), actualSize);
- StartConnectionFromFile(myFSS);
- END;
- myErr := AEDisposeDesc(docList);
- END
- ELSE
- BEGIN
- AEOpenDocHandler := errAEEventNotHandled; { can't handle it now, a session is open }
- END;
- AEOpenDocHandler := myErr;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION AEPrintHandler (messagein: AppleEvent;
- reply: AppleEvent;
- refIn: LongInt): OSErr;
- BEGIN
- { no printing handler in yet, so we'll ignore this }
- { the operation is functionally identical to the ODOC event, with the addition }
- { of calling your print routine. }
- { we of course don't do anything here }
- AEPrintHandler := errAEEventNotHandled; { we have no docs, so no pdoc events should come to us }
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- { Standard Quit event handler, to handle a Quit event from the Finder, for example. }
- { ••••• DO NOT CALL EXITTOSHELL HERE ••••• or you will never have a happy life. }
- FUNCTION AEQuitHandler (messagein: AppleEvent;
- reply: AppleEvent;
- refIn: LongInt): OSErr;
- BEGIN
- { prepQuit sets the Stop flag for us. It does _NOT_ quit, you }
- { should NEVER quit from an AppleEvent handler. Calling }
- { ExitToShell here would blow things up }
- gQuit := TRUE;
- AEQuitHandler := noErr;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- { I'm not doing error handling in this sample for clarities sake, you should. }
- { Hah, easy for me to say, huh? }
- PROCEDURE DoHighLevel (AERecord: EventRecord);
- VAR
- err: OSErr;
- BEGIN
- err := AEProcessAppleEvent(AERecord);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE FixFileMenu;
- BEGIN
- IF (gPPCSessRefNum = 0) THEN
- { Enable Open and disable Save }
- BEGIN
- EnableItem(gFileMenuHandle, kOpenItem);
- DisableItem(gFileMenuHandle, kSaveItem);
- END
- ELSE
- { Disable Open and enable Save }
- BEGIN
- DisableItem(gFileMenuHandle, kOpenItem);
- EnableItem(gFileMenuHandle, kSaveItem);
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE FixSharingMenu;
- VAR
- menuString: Str255;
- BEGIN
- IF (gPPCSessRefNum = 0) THEN
- GetIndString(menuString, kRemoteMenu, kConnectString)
- ELSE
- GetIndString(menuString, kRemoteMenu, kDisconnectString);
-
- SetMenuItemText(gRemoteMenuHandle, kConnectToRemote, menuString);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE PPCProcessReads;
- VAR
- h: Handle;
- SCpbPtr: RemoteSCPBRecPtr;
- err: OSErr;
- bttnStr: Str255;
- BEGIN
- IF (gPPCDataRead) THEN { process the data read }
- BEGIN
- SCpbPtr := RemoteSCPBRecPtr(@gPPCReadBuffer); { type-cast data read }
- IF ((gFirstStatus) OR (SCpbPtr^.scPB.pollServerPB.scServerState <> oldSCServerState)) THEN
- BEGIN
- { store current server state so we don't have to update needlessly }
- gFirstStatus := FALSE;
- oldSCServerState := SCpbPtr^.scPB.pollServerPB.scServerState;
-
- SetPort(myWindow);
- h := GetResource('RECT', kRemoteStatusText);
- HLock(h);
- InvalRect(RectHndl(h)^^);
- HUnlock(h);
-
- CASE oldSCServerState OF
- SCPSJustDisabled, SCPSSleeping:
- BEGIN
- GetIndString(bttnStr, kWindowButton, kButtonStart);
- SetControlTitle(gWindowButton, bttnStr);
- END;
- SCPSRunning:
- BEGIN
- GetIndString(bttnStr, kWindowButton, kButtonStop);
- SetControlTitle(gWindowButton, bttnStr);
- END;
- OTHERWISE { SCPSStartingUp, or shutting down (0..4094) }
- BEGIN
- GetIndString(bttnStr, kWindowButton, kButtonCancel);
- SetControlTitle(gWindowButton, bttnStr);
- END;
- END;
- END;
-
- { Now, fill out the readParam parameter block and call PPCRead }
- WITH gPPCGeneralRec.readParam DO
- BEGIN
- ioCompletion := @ReadCompProc;
- bufferLength := sizeof(RemoteSCPBRec); { full buffer size again }
- { We're reusing the same parameter block, so the sessRefNum }
- { is already filled in for us. }
- bufferPtr := @gPPCReadBuffer;
- END;
- gPPCDataRead := FALSE;
- err := PPCRead(@gPPCGeneralRec.readParam, TRUE); { asynchronously }
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE doNullEvt;
- BEGIN
- IF (gPPCSessRefNum <> 0) THEN
- BEGIN
- PPCProcessReads;
- END
- ELSE IF (myWindow <> NIL) THEN
- { The session is gone, but the window is open. Close it! }
- BEGIN
- DisposeWindow(myWindow);
- myWindow := NIL;
- gWindowButton := NIL;
- gNoLocationZoneName := '';
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE WriteCompProc (pb: PPCParamBlockPtr);
- { This procedure gets called when the asynchronous PPCWrite call completes.}
- { If no errors are detected, then it puts the parameter block in the }
- { gWpbQueue where the PollTheServer procedure will find it next time it }
- { needs to send data to the remote. }
- { If an error is detected, then PPCEnd is called asynchronously to close}
- { the session. }
-
- VAR
- err: OSErr; { used to catch the PPC function results. }
-
- BEGIN
- IF (PPCWritePBPtr(pb)^.ioResult = noErr) THEN
- BEGIN
- gPPCWriteInProgress := FALSE;
- err := WakeUpProcess(gOurPSN); { update button control ASAP }
- END
- ELSE
- BEGIN
- { if we get an error, then we call PPCEnd to close up cleanly}
- PPCEndPBPtr(pb)^.ioCompletion := @EndCompProc;
- err := PPCEndAsync(PPCEndPBPtr(pb));
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE DrawOKoutline (theDialog: DialogPtr;
- itemNo: Integer);
- { draw the dialogLine and okOutline user items }
- VAR
- itemType: Integer;
- item: Handle;
- box: Rect;
- BEGIN
- GetDialogItem(theDialog, ok, itemType, item, box);
- InsetRect(box, -4, -4);
- PenSize(3, 3);
- FrameRoundRect(box, 16, 16);
- PenSize(1, 1);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE IBeamIt (theDialog: DialogPtr);
- VAR
- itemNum: Integer;
- kind: Integer;
- h: Handle;
- r: Rect;
- pt: Point;
- BEGIN
- itemNum := DialogPeek(theDialog)^.EditField + 1;
- GetDialogItem(theDialog, itemNum, kind, h, r);
- GetMouse(pt);
- IF (PtInRect(pt, r)) THEN
- SetCursor(GetCursor(1)^^)
- ELSE
- InitCursor;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
-
- FUNCTION SnatchHandle (theDialog: DialogPtr;
- item: Integer): ControlHandle;
- VAR
- kind: Integer;
- h: Handle;
- r: Rect;
- BEGIN
- GetDialogItem(theDialog, item, kind, h, r);
- SnatchHandle := ControlHandle(h);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION RangeIsSelected (theDialog: DialogPtr): Boolean;
- { See if theDialog's current edit item has any text selected }
- BEGIN
- WITH TEHandle(DialogPeek(theDialog)^.textH)^^ DO
- RangeIsSelected := (selStart <> selEnd);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION ShutdownDialogFilter (theDialog: DialogPtr;
- VAR theEvent: EventRecord;
- VAR itemHit: Integer): Boolean;
- CONST
- enterChar = $03;
- deleteChar = $08;
- returnChar = $0D;
- escapeChar = $1B;
- leftArrowChar = $1C;
- rightArrowChar = $1D;
- upArrowChar = $1E;
- downArrowChar = $1F;
- VAR
- temp: WindowPtr;
- chCode: Integer;
- finalTicks: LongInt;
- itemNum: Integer;
- kind: Integer;
- h: Handle;
- r: Rect;
- pt: Point;
- myStr: Str255;
- BEGIN
- GetPort(temp);
- SetPort(theDialog);
- ShutdownDialogFilter := FALSE;
- IBeamIt(theDialog);
- WITH theEvent DO
- IF ((what = keyDown) OR (what = autoKey)) THEN
- BEGIN
- chCode := BitAnd(message, CharCodeMask);
- CASE chCode OF
- enterChar, returnChar:
- BEGIN
- itemHit := ok;
- HiliteControl(SnatchHandle(theDialog, itemHit), kControlButtonPart);
- Delay(8, finalTicks);
- HiliteControl(SnatchHandle(theDialog, itemHit), kControlNoPart);
- SetPort(temp);
- ShutdownDialogFilter := TRUE;
- END;
- escapeChar:
- BEGIN
- itemHit := cancel;
- HiliteControl(SnatchHandle(theDialog, itemHit), kControlButtonPart);
- Delay(8, finalTicks);
- HiliteControl(SnatchHandle(theDialog, itemHit), kControlNoPart);
- SetPort(temp);
- ShutdownDialogFilter := TRUE;
- END;
- OTHERWISE
- IF ((DialogPeek(theDialog)^.editField + 1) = kShutdownTime) THEN
- BEGIN
- GetDialogItem(theDialog, kShutdownTime, kind, h, r);
- GetDialogItemText(h, myStr);
- IF (NOT (chCode IN [deleteChar, leftArrowChar..downArrowChar])) THEN
- IF (((NOT RangeIsSelected(theDialog)) AND (Length(myStr) >= 3)) OR (NOT (chCode IN [$30..$39]))) THEN
- BEGIN
- SysBeep(1);
- ShutdownDialogFilter := TRUE;
- END;
- END;
- END; { case }
- END;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- FUNCTION doGetShutDownTime (VAR minutes: Integer): Boolean;
- VAR
- dPtr: DialogPtr;
- itemHit: Integer;
-
- itemType: Integer;
- item: Handle;
- box: Rect;
-
- ShutdownTimeStr: Str255;
- ShutdownTime: LongInt;
- BEGIN
- dPtr := GetNewDialog(kShutdownDialog, NIL, pointer(-1));
-
- { set procedure pointer for OK button outline }
- GetDialogItem(dPtr, kShutdownOKOutline, itemType, item, box);
- SetDialogItem(dPtr, kShutdownOKOutline, itemType, Handle(@DrawOKoutline), box);
-
- ShowWindow(dPtr);
-
- SelectDialogItemText(dPtr, kShutdownTime, 0, 32767);
- REPEAT
- ModalDialog(@ShutdownDialogFilter, itemHit);
- UNTIL ((itemHit = OK) OR (itemHit = cancel));
- IF (itemHit = OK) THEN
- BEGIN
- doGetShutDownTime := TRUE;
- { Grab the minutes }
- GetDialogItem(dPtr, kShutdownTime, itemType, item, box);
- GetDialogItemText(item, ShutdownTimeStr);
- StringToNum(ShutdownTimeStr, ShutdownTime);
- minutes := ShutdownTime;
- END
- ELSE
- doGetShutDownTime := FALSE;
- DisposeDialog(dPtr);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE doMyWindContent (window: WindowPtr;
- event: EventRecord);
- VAR
- part: Integer;
- control: ControlHandle;
- err: OSErr;
- sendIt: Boolean;
- BEGIN
- SetPort(window);
- GlobalToLocal(event.where); {convert to local coordinates}
- IF (FindControl(event.where, window, control) <> 0) THEN
- IF (TrackControl(control, event.where, NIL) <> 0) THEN
- BEGIN { there's only one control to track and it was used }
- IF (NOT gPPCWriteInProgress) THEN
- BEGIN { send a server command }
- CASE oldSCServerState OF
- SCPSJustDisabled: { send SCStartServer }
- BEGIN
- WITH gRemoteSCpb.scPB.startPB DO
- BEGIN
- scCode := SCStartServer;
- scStartSelect := kCurInstalled;
- scEventSelect := kFinderExtn;
- {scWhere := LongInt('fext');}
- {scReceiverID := LongInt('MACS');}
- {scDataType := LongInt('fext');}
- {scStartOptions := 0;}
- END;
- sendIt := TRUE;
- END;
- SCPSSleeping: { send SCWakeServer }
- BEGIN
- gRemoteSCpb.scPB.startPB.scCode := SCWakeServer;
- sendIt := TRUE;
- END;
- SCPSRunning: { send SCShutDown with x minutes }
- BEGIN
- IF (doGetShutDownTime(gRemoteSCpb.scPB.disconnectPB.scNumMinutes)) THEN
- BEGIN
- WITH gRemoteSCpb.scPB.disconnectPB DO
- BEGIN
- scCode := SCShutDown;
- scDiscArrayPtr := NIL;
- scArrayCount := 0;
- { scNumMinutes filled in already }
- scFlags := 0; { we have no message }
- { $2000 if we did have message }
- scMessagePtr := NIL; { set by server controller }
- gRemoteSCpb.scMessageOrName := '';
- END;
- sendIt := TRUE;
- END
- ELSE
- sendIt := FALSE; { canceled at doGetShutDownTime }
- END;
- SCPSStartingUp: { send SCShutDown with 0 minutes }
- BEGIN
- WITH gRemoteSCpb.scPB.disconnectPB DO
- BEGIN
- scCode := SCShutDown;
- scDiscArrayPtr := NIL;
- scArrayCount := 0;
- scNumMinutes := 0;
- scFlags := 0; { no message }
- gRemoteSCpb.scMessageOrName := '';
- scMessagePtr := NIL; { set by server controller }
- END;
- sendIt := TRUE;
- END;
- OTHERWISE { shutting down (0..4094), so send SCCancelShutDown }
- BEGIN
- gRemoteSCpb.scPB.disconnectPB.scCode := SCCancelShutDown;
- sendIt := TRUE;
- END;
- END;
-
- IF (sendIt) THEN { now, send it }
- BEGIN
- WITH gPPCWriteRec.writeParam DO
- BEGIN
- ioCompletion := @WriteCompProc;
- sessRefNum := gPPCSessRefNum;
- bufferLength := sizeof(RemoteSCPBRec);
- bufferPtr := @gRemoteSCpb;
- more := FALSE;
- { I'm not using userData, blockCreator, or blockType }
- END;
-
- gPPCWriteInProgress := TRUE;
- err := PPCWriteAsync(PPCWritePBPtr(@gPPCWriteRec));
- END;
- END
- ELSE
- BEGIN { should never get to here - button is disabled during writes }
- SysBeep(1);
- END;
- END; { IF TrackControl... }
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- PROCEDURE DoEventLoop;
- { yeah, first I took it out of the main program and now I think I'll split it up }
- { into smaller pieces. However, it'll still be in the same source code file }
- { (don't you hate having to look all over hell for code) }
- VAR
- twindow: WindowPtr;
- evtRecord: EventRecord;
- bob: Boolean;
- BEGIN
- REPEAT
- bob := WaitNextEvent(everyEvent, evtRecord, 30, NIL);
- HiliteMyButton;
- CASE evtRecord.what OF
- nullEvent:
- ;
- mouseDown:
- { first, see where the hit was }
- BEGIN
- CASE FindWindow(Point(evtRecord.where), twindow) OF
- inDesk:
- { if they hit in desk, then the process manager }
- { will switch us out, we don't need to do anything }
- BEGIN
- END;
- inMenuBar:
- BEGIN
- FixFileMenu;
- FixSharingMenu;
- DoSelected(MenuSelect(evtRecord.where));
- END;
- inSysWindow:
- { pass to the system }
- BEGIN
- SystemClick(evtRecord, twindow);
- END;
- inContent:
- { handle content and control clicks here }
- BEGIN
- IF (twindow <> FrontWindow) THEN
- SelectWindow(twindow)
- ELSE IF (twindow = myWindow) THEN
- BEGIN
- doMyWindContent(twindow, evtRecord);
- END;
- END;
- inDrag:
- BEGIN
- IF (twindow = FrontWindow) THEN
- DragWindow(twindow, Point(evtRecord.where), qd.screenBits.bounds);
- END;
- inGrow:
- { Call GrowWindow here if you have a grow box }
- BEGIN
- END;
- inGoAway:
- { Click in Close box }
- BEGIN
- END;
- OTHERWISE
- ;
- END; { CASE FindWindow(evtRecord.message, twindow) }
- END;
- mouseUp:
- ;
- { don't care }
- keyDown, { same action for key or auto key }
- autoKey:
- IF (BAND(evtRecord.modifiers, cmdKey) <> 0) THEN
- BEGIN
- FixFileMenu;
- FixSharingMenu;
- DoSelected(MenuKey(CHAR(BAND(evtRecord.message, charCodeMask))));
- END;
- keyUp:
- ;
- { don't care }
- updateEvt:
- { draw whatever window needs an update }
- DrawMain(WindowPtr(evtRecord.message));
- diskEvt:
- { I don't do anything special for disk events, this just passes them }
- { to a function that checks for an error on the mount }
- DoDiskEvents(evtRecord.message);
- activateEvt:
- IF (BAND(evtRecord.modifiers, activeFlag) <> 0) THEN
- DrawMain(WindowPtr(evtRecord.message));
- osEvt:
- CASE BSR(evtRecord.message, 24) OF { high byte of message }
- mouseMovedMessage:
- ;
- { don't care }
- suspendResumeMessage: {suspend/resume is also an activate/deactivate }
- BEGIN
- gInBackground := BAND(evtRecord.message, resumeFlag) = 0;
- IF NOT gInBackGround THEN
- InitCursor;
- END;
- OTHERWISE
- ;
- END;
- kHighLevelEvent:
- DoHighLevel(evtRecord);
- OTHERWISE
- ;
- END; { CASE evtRecord.what }
- doNullEvt;
- UNTIL (gQuit = TRUE);
- END; { DoEventLoop }
-
- {------------------------------------------------------------------------------}
-
- {$S Initialize}
- PROCEDURE DoSetupMenus;
- VAR
- helpHandle: MenuHandle;
- helpString: StringHandle;
- count: Integer;
- BEGIN
- gMymenu := GetNewMBar(kMBarID);
- SetMenuBar(gMymenu);
- gAppleMenuHandle := GetMenuHandle(kAppleMenu);
- gFileMenuHandle := GetMenuHandle(kFileMenu);
- gEditMenuHandle := GetMenuHandle(kEditMenu);
- gRemoteMenuHandle := GetMenuHandle(kRemoteMenu);
- AppendResMenu(gAppleMenuHandle, 'DRVR');
-
- { now install my Help menu item in the Help Manager's menu }
- IF (HMGetHelpMenuHandle(helpHandle) = noErr) THEN { Get the Help menu handle }
- BEGIN
- count := CountMItems(helpHandle); { How many items are there? }
- helpString := GetString(kHelpString);{ get my help menu item string }
- DetachResource(Handle(helpString)); { detach it }
- HNoPurge(Handle(helpString));
- MoveHHi(Handle(helpString));
- HLock(Handle(helpString));
- InsertMenuItem(helpHandle, helpString^^, count + 1); { insert my item in the Help menu }
- gHelpItem := CountMItems(helpHandle); { The number of the item }
- END
- ELSE
- gHelpItem := 0; { error - set it to something that we'll never see }
-
- DrawMenuBar;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Initialize}
- FUNCTION InitAEStuff: Boolean;
- VAR
- err: OSErr;
- BEGIN
- { The following series of calls install our AppleEvent Handlers. }
- { These handlers are added to the application event handler list }
- { that the AppleEvent manager maintains. So, whenever an }
- { AppleEvent happens and we call AEProcessEvent, the AppleEvent }
- { manager will check our list of handlers and dispatch to the }
- { the correct handler if there is one. }
- err := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @AEOpenHandler, 0, false);
- IF (err = noErr) THEN
- err := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, @AEOpenDocHandler, 0, false);
- IF (err = noErr) THEN
- err := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @AEQuitHandler, 0, false);
- IF (err = noErr) THEN
- err := AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, @AEPrintHandler, 0, false);
-
- IF (err <> noErr) THEN
- NotifyAndExit(kExitAEHandlerNotInstalled); { Bail out now }
-
- InitAEStuff := (err = noErr);
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Initialize}
- FUNCTION NumToolboxTraps: Integer;
- BEGIN
- IF (NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap)) THEN
- NumToolboxTraps := $200
- ELSE
- NumToolboxTraps := $400;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Initialize}
- FUNCTION GetTrapType (theTrap: Integer): TrapType;
- CONST
- TrapMask = $0800;
- BEGIN
- IF (BAND(theTrap, TrapMask) > 0) THEN
- GetTrapType := ToolTrap
- ELSE
- GetTrapType := OSTrap;
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Initialize}
- FUNCTION TrapAvailable (theTrap: Integer): Boolean;
- VAR
- tType: TrapType;
- BEGIN
- tType := GetTrapType(theTrap);
- IF (tType = ToolTrap) THEN
- BEGIN
- theTrap := BAND(theTrap, $07FF);
- IF (theTrap >= NumToolboxTraps) THEN
- theTrap := _Unimplemented;
- END;
- TrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress(_Unimplemented, ToolTrap)
- END;
-
- {------------------------------------------------------------------------------}
-
- {$S Initialize}
- PROCEDURE InitializeApp;
- VAR
- vers: LongInt;
- err: OSErr;
- aLong: LongInt;
- macintoshName: StringHandle;
- savedResFile: Integer;
- i: Integer;
- curVersion: VersRecHndl;
- BEGIN
- myWindow := NIL;
- gWindowButton := NIL;
- gQuit := FALSE;
-
- gPPCPortOpen := FALSE;
- gPPCPortRefNum := 0;
- gFirstStatus := TRUE; { reset gFirstStatus so first status returned by a }
- { new connection updates the status message }
- gPPCSessRefNum := 0;
- gPPCDataRead := FALSE;
- gPPCWriteInProgress := FALSE;
-
- err := GetCurrentProcess(gOurPSN); { so completion routines can wake us up }
-
- MaxApplZone;
- { MoreMasters go here if you need'm }
- InitGraf(@qd.thePort);
- InitFonts;
- InitWindows;
- InitMenus;
- TEInit;
- InitDialogs(NIL);
- InitCursor;
-
- IF (NOT TrapAvailable(_Gestalt)) THEN
- BEGIN
- { If Gestalt isn't available, then we can't even notify the user }
- { because we can't see if the Notification Manager is available }
- SysBeep(1); { so ring the bell }
- ExitToShell; { and exit }
- END;
-
- { see if Notification Manager is available to display error messages }
- gNotificationMgrPresent := Gestalt(gestaltNotificationMgrAttr, aLong) = noErr;
-
- FOR i := 1 TO kNumExitErrors DO
- GetIndString(gNMStrs[i], kExitErrorStrings, i);
-
- { Check system version }
- vers := 0;
- err := Gestalt(gestaltSystemVersion, vers);
- IF (LoWord(vers) < $0700) THEN
- BEGIN
- NotifyAndExit(kExitNoSystem7); { Bail out now }
- Exit(InitializeApp);
- END;
-
- { Check this machine for AppleEvents. }
- { If they are not here, then we exit }
- IF (Gestalt(gestaltAppleEventsAttr, aLong) <> noErr) THEN
- BEGIN
- NotifyAndExit(kExitNoAppleEvts); { Bail out now }
- Exit(InitializeApp);
- END;
-
- IF (NOT InitAEStuff) THEN
- Exit(InitializeApp);
-
- curVersion := VersRecHndl(Get1Resource('vers', 1));
- IF (curVersion <> NIL) THEN
- BEGIN { get version info }
- gShortVersStr := curVersion^^.shortVersion; { short version string }
- END
- ELSE
- BEGIN { at least initialize them }
- gShortVersStr := '';
- END;
-
- IF (NOT InitPPCStuff) THEN
- Exit(InitializeApp);
-
- DoSetupMenus; { set up my menus }
-
- gNoLocationZoneName := '';
- END;
-
- {------------------------------------------------------------------------------}
-
- {PROCEDURE _DataInit;}
- {External;}
- { this is the application initialization code }
-
- {------------------------------------------------------------------------------}
-
- {$S Main}
- BEGIN
- {UnloadSeg(@_DataInit);}
- { throw out the setup code }
- InitializeApp;
- UnloadSeg(@InitializeApp); { get rid of my initialization code }
- DoEventLoop;
- PPCShutDown
- END. { Main }